(module type-pprint mzscheme
  (require "types.scm")
  (require (lib "plt-match.ss")
           (only (lib "1.ss" "srfi") fold))
  (require (planet "pprint.ss" ("dherman" "pprint.plt" 3 0)))
  
  ;; adds an occurrence of element between every pair in lst
  (define (intersperse elt lst)
    (if (<= (length lst) 1) lst
        (let loop ((ans (list elt (car lst)))
                   (lst (cdr lst)))
          (if (null? lst)
              (reverse (cdr ans))
              (loop (list* elt (car lst) ans) (cdr lst))))))
  
  ;; Pretty print a type constructor
  (define (tycon->doc tycon)
    (match tycon
      ((struct tycon-int ())  (text "int"))
      ((struct tycon-bool ()) (text "bool"))
      ((struct tycon-num ())  (text "num"))
      
      ((struct tycon-list ())         (text "list"))
      ((struct tycon-pure-arrow ())   (text "->"))
      ((struct tycon-impure-arrow ()) (text "~>"))
      
      ((struct tycon-tuple ()) (text "tuple"))
      
      ((struct tycon-cons ()) (text "cons"))
      ((struct tycon-null ()) (text "null"))
      
      ((struct tycon-bot ()) (text "bot"))
      ((struct tycon-top ()) (text "top"))))
  
  ;; Function to pretty print types
  (define (type->doc ty)
    (match ty
      ((struct ty-var (id))        (h-append (char #\') (text (symbol->string id))))
      ((? list? tys) 
       (if (<= (length tys) 1)
           (hs-concat (map type->doc tys))
           (h-append lparen (hs-concat (map type->doc tys)) rparen)))
      ((struct ty-app (tycon args))
       (cond ((zero? (length args)) (tycon->doc tycon))
             (else
              (h-append lparen 
                        (hs-concat (cons (tycon->doc tycon) 
                                         (map type->doc args)))
                        rparen))))))
  
  (provide type->string)
  (define (type->string ty) (pretty-format (type->doc ty)))
  )